perm filename SMOOTH.FAI[XGP,BGB] blob
sn#041588 filedate 1973-05-11 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00014 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00003 00002 NSUBR BABYKILLER,LEVEL KILL POLYGONS OF ONE PIXEL
C00005 00003 NSUBR KILIMG,IMG KILL AN IMAGE
C00006 00004 NSUBR KLPOLY,POLYGON KILL POLYGON RETURN CCW(PGN)
C00008 00005 NSUBR KLVERT,OBJ KILL A VERTEX, SKIP IF SUCCESSFUL
C00010 00006 NSUBR FNDPSON,POLYGON FIND NEW SON IF SON HAS BEEN KILLED OR MOVED
C00011 00007 NSUBR ORTHMUNG,OBJECT SEARCH FOR ORTHAGONAL LINES AND MUNG THEM ONTO PIXEL BOUNDARIES
C00016 00008 NSUBR SMOOTH,LEVEL
C00019 00009 NSUBR MKARCS,VERT1,VERT2 MAKE ARCS - FROM U1 CCW TO U2
C00024 00010 NSUBR FARCL,PGON FIT ARCS LINEAR.
C00026 00011 ----- FARCL COMPUTE SYMMETRIC LEAST SQUARES LINE COEFFICIENTS.
C00029 00012 NSUBR KILVIC,LEVEL KILL VIDEO INTENSITY CONTOURS OF THE PREVIOUS LEVEL.
C00031 00013 SUBRS KLARCL,KLARCP KILL ARCS OF LEVEL, OF POLYGON
C00034 00014 NSUBR(ARCVIC,LVL)MAKE ARC RING INTO VIC RING
C00036 ENDMK
C⊗;
NSUBR BABYKILLER,LEVEL ;KILL POLYGONS OF ONE PIXEL
; -BGB- 28 DEC 1972.
ACCUMULATORS{A,PG,E0,E1,E2,Q,R}
SKIPN FLGBK↔POP1J
MOVE 1,ARG1↔SON PG,1↔MOVEM PG,PG0#
;KLUDGE - SPARE SON POLYGON UNTIL WE CAN THINK OF A POLICY.
GO L3
;ELIMINATE INSIGNIFICANT CONTOURS - SMALL LOW CONTRAST.
L1: NCNT 0,PG↔MOVM
CAIL =10↔GO L3
;RELEASE VIC NODES OF THE POLYGON.
SON E0,PG
MOVE E1,E0
L2: CCW E2,E1
CALL(KILL,E1)
CAMN E2,E0↔GO .+3
MOVE E1,E2↔GO L2
;KILL A BABY POLYGON.
HLRZ Q,(PG)↔HRRZ R,(PG)
HRLM Q,(R)↔ HRRM R,(Q) ;RINGO PG.
CALL(KILL,PG)
SKIPA PG,R ;CCW FROM OUT OF THE GRAVE.
;ADVANCE TO NEXT POLYGON ON THIS LEVEL.
L3: CCW PG,PG↔CAME PG,PG0↔GO L1
POP1J
SUBREND BABYKILLER;6-JAN-73(BGB)
NSUBR KILIMG,IMG ;KILL AN IMAGE
HRRZ 1,IMG
SON 1,1
MOVEM 1,LVL#
MOVEM 1,LVL0#
LOOP: MOVE 1,LVL
JUMPE 1,LDONE
SON 1,1
JUMPE 1,PDONE
CALL(KLPOLY,1)
GO LOOP
PDONE: MOVE 1,LVL
CCW 0,1
HRRZ 2,IMG
SON. 0,2
CAMN 0,LVL0
SETZM LVL
CALL(KILL,1)
GO LOOP
LDONE: HRRZ 1,IMG
CCW 2,1
CAMN 2,1
GO [ SETZ 2,
GO FINISH ]
CW 3,1
CCW. 2,3
CW. 3,2
FINISH: MOVE 3,FILM
SON 0,3
CAMN 0,1
SON. 2,3
CAMN 1,QBLK
MOVEM 2,QBLK
CALL(KILL,1)
MOVE 1,FILM
SON 1,1
POP1J
SUBREND KILIMG
NSUBR KLPOLY,POLYGON ;KILL POLYGON RETURN CCW(PGN)
; BGB - 7 JANUARY 1973.
ACCUMULATORS{PG,E0,E1,E2,Q,R}
MOVE PG,POLYGON
;RELEASE VIC NODES OF THE POLYGON.
TEST PG,PBIT
GO [FATAL(KLPOLY CALLED WITH NON-POLYGON)]
SON E0,PG ;KILL VICS
MOVE E1,E0
L1: CCW E2,E1
CALL(KILL,E1)
CAMN E2,E0↔GO .+3
MOVE E1,E2↔GO L1
ARC E0,PG ;DON'T FORGET THE ARCS!
MOVE E1,E0
TEST E1,ARCBIT
GO L1B
L1A: CCW E2,E1
CALL(KILL,E1)
CAMN E2,E0↔GO .+3
MOVE E1,E2↔GO L1A
;RING OUT & KILL POLYGON NODE,
L1B: NGON Q,PG↔PGON R,PG↔JUMPE R,L2
NGON. Q,R↔PGON. R,Q↔CAMN PG,R↔SETZ R,
EXO 1,PG↔JUMPE 1,.+4↔ENDO 0,1↔CAMN 0,PG↔ENDO. R,1
ENDO 1,PG↔SKIPE 1↔HRRZS 3(1) ;MY ENDO BECOMES AN ORPHAN.
L2: HLRZ Q,(PG)↔HRRZ R,(PG)
HRLM Q,(R)↔ HRRM R,(Q) ;RINGO PG.
;DOES DAD NEED A NEW FIRST SON. (MOVED BEFORE CALL TO KILL - TVR)
DAD 1,R
CAMN PG,R↔SETZ R,
SON 0,1↔CAMN 0,PG↔SON. R,1
CALL(KILL,PG)
;RETURN PGON CCW FROM OUT OF THE GRAVE.
MOVE 1,R
POP1J
SUBREND KLPOLY;8-JAN-73(BGB)
NSUBR KLVERT,OBJ ;KILL A VERTEX, SKIP IF SUCCESSFUL
ACCUMULATORS{THIS,NEXT,LAST,T}
HRRZ THIS,OBJ
TYPE T,THIS↔ TRNN T,(VBIT)
GO [FATAL(AT KLVERT WITHOUT A VERTEX)]
SKIPN 3(THIS)↔SKIPE 4(THIS) ;CHECK THIS!
SETZ 0,
ARC T,THIS↔SKIPE T↔ARC. 0,T ;ZERO ARC POINTER, IF ANY
; NTIME LAST,THIS↔PTIME NEXT,THIS ;UPDATE PTIME & NTIME
; SKIPE 6(THIS)↔CAME THIS,NEXT↔GO KLVEC2
; NTIME. LAST,NEXT↔PTIME. NEXT,LAST
KLVEC2: CW NEXT,THIS↔CCW LAST,THIS ;UPDATE NEXT & LAST
CAMN LAST,THIS↔POP1J ;FAILURE RETURN IF LAST VECTOR!
CW. NEXT,LAST↔CCW. LAST,NEXT
PUSHP LAST ;SAVE POINTER TO VERTEX TO RETURN
PGON LAST,THIS ;IF THE VERTEX BEING DELETED POINTED
NCNT 0,LAST
SUBI 0,1
NCNT. 0,LAST
SON LAST,LAST
CAMN LAST,THIS ;BY POLYGON, THEN FIX THAT TOO.
GO [ PUSHACS
PGON LAST,THIS
CCW 1,THIS
SON. 1,LAST ;TENTATIVE SON
CALL(FNDPSON,LAST)
POPACS
GO C1 ]
C1: CALL(KILL,THIS)
POPP 1↔AOS(P)↔POP1J
SUBREND KLVERT;18-FEB-73(TVR)
→≥'+ $A
≥⊃!'∨≤1!∨→3≥∨≤∩w→∪≥λA9.A'=≤A∪↓'∨≤A!β&A¬∃≤A↔%→→λ↓∨$A≠=-λ~(∪βππU≠+→βQ∨%'wX`Y,YQ∨ Yπ5∪≤Y%5∪≥|~(∪≠∨-∀@bY!=→3∂∨8~∀∪)∃'(@b1!¬∪(4∀∪∂≡↓6A
βQβ_Q
9 !∂∨8Aπβ→0A/∪) A≥∨≤5!∨→3≥∨≤RAt~∀∪'=≤A,`0b~∀∪5∨-
AQ∨ Y,@~∀∪%=.A%≠%≤Y)∨@~∀∪π=_Aπ≠%≤Y)∨@~∀∪≠=-
A,1,`~∃0bt∪%=.@bYX~∀∪π¬≠_@b1%≠∪≤4∀∪∂≡↓6Aπβ5
@bYI≠∪≤~(∩@@@A∂≡A0f~∀∩@@@A
∨_@`1,~∀∩@@@A
β≠_@@Yπ≠∪8~∀∩@@@A∂<A_f~(∩@@@A∂≡A0dA:~(∪π∨_`Y,~)_dt∪5∨-~bY%≠%≤~∀∪5∨-~`Yπ≠%≤~∀∪5∨-~↓,Y)∨@~∃_fh∪ππ.↓,Y,~(∪πβ≠∀A,Y,@~∀∪∂<A_b~(∪≠∨-∀@bY!=→3∂∨8~∀∪'=≤\A)= Xb~(∪!∨ E∀~∃'U¬%≥⊂A
≥ A'∨≤vP[≠β$4ndQ)Y$R~∀→≥'+ $A∨%Q⊃≠+≥≤Y∨¬∃∃π(∩wMβ%π A
∨$↓∨%)⊃¬∂∨≥β0A→∪≥∃&Aβ≥⊂A≠+≥≤A)⊃4A∨≥)<A!∪1∃_A¬∨U≥ β%%&v~(∪βππU≠+→βQ∨%'wbYεd1εfY$DY$dYHfY,b1,dY,LY,a|4∀∪≠∨Y
@bY=¬∃πP~∀∪∃U≠!
@DY!∨ E∀\~∀%)'(bY-¬%(∩wβI
A/
↓β(A-∃%)0↓→-0A3(|~∀∪∂<A6∩@@A)M)4@b1
¬∪(4∀∩∩@@A'∨8@bXb4∀∩@@@A∨→=∨ tAA+'⊂A@Xb∩@@@@@m≥≡XAMβ-
A=¬∃πP~∀∩∩@@A'=≤@bXDX∩@@@@@w≥(A⊃%&A'∨8~∀∩∩@@Aπ¬→_Q∨I)⊃≠+9∞XbR@w≠+9∞A⊃∪LA%∪≥≤~∀∩∩@@A!= A XD∩@@@@@w∂∃(A¬β
⊗A∨¬)π(~(∩∩@@Aππ.bXb∩@@@@w≥1PA∪≤AI∪≥∞~(∩∩@@Aπβ≠∀@bY∨ ∃π(@@@@m ∨≥
↓3(}4∀∩∩@@A∂≡↓∨→∨∨@~∀∩∩@@A!= c∀At∩@@@@@w3∃&Y%Q+%≤~(∪≠∨-∀A,`XD∩w%5≠¬HA¬∂%≥≥∪≥≤A∨AI∪≥∞~(∪π.AXbY,`$w∪≥∪Q∪β→∪i
A-I)0AA∨∪≥)∃%&~∀%≠∨-
↓,dY,@~∀∪%=.A$b1,b/β⊃ ∩A$DXh`/¬≥ π≠$A$bX\n@@w¬≥λA)!∪$AI'!
)∪-
↓%∨/&↓β≥λA
∨→+≠9&~∀∪I∨.A$HY,d/¬ ∩AHdXh`]β≥ π5∩A$d0nn~∀%π∨_AbY,b]β ∩↓εbXh@/β≥
≠∩AεDXnn~(∪π∨_↓εdY,H/β $AεdXP`/β≥⊃π≠∩AdXnn4∀∪∂≡↓-_b∩$∩w'↔% Aβ Yβ≥π
↓π∨
4∃-→∨= t∪≠=-
@`171/λ↓εdYεE:∩wβ⊃-β≥π∀A)≡A91(AY%)`~∀∪¬1(A,d4∃-_bh∪ππ.↓,fY,H∩∩w+A β)
↓,fAβ9λA%M!π)%-
A%=.Aβ≥⊂Aπ∨→U≠≤~∀%%∨.AHfY,f]β ∩↓$fXh@/β≥
≠∩A$LXnn~(∪π∨_↓εfY,L/β $AεfXP`/β≥⊃π≠∩AfXnn4∀∪πβ5≤A$b1$d∩∩m/∨+→⊂A)⊃∪LA¬
A∧A%∪∂!(Aβ≥≥→
}~(∪πβ≠∀AεdYf~∀∪≥≡A-_H∩∩∩w9∨(A
I∨~A%=.A)≡↓π∨→+5≤~∀∪5∨-
@@Y$d∩$wβ≥λ↓β%
A ∨)⊂A1∂&A1∨≥∂HA)⊃β8A∨%)!π∨≤}4∀∪'+λ@`Y$L~∀∪≠=-~@`0`~∀∪
β∪∞@@Xb``4∀∪∂≡↓-_f~(v∪πβ5∂
@`1∨%)⊃
∨≤~∀l∪∂≡AY_f∩∩$w%∨.↓!β%(↓)∨≡AM⊃∨%(4∀∪≠∨Y
@bYb~∀∪M+∧@b1εd~∀%≠∨-~bXb~(∪πβ∪≤@bXb@`~∀∪≥≡A-_L~∀∪∪5+_@b0`~∀∪
β≠∂
bY∨%Q⊃π∨≤4∀∪∂≡↓-_f∩$∩wπ∨1+≠≤AAβ%(AQ∨≡A'!∨%(~(∪%∨.8A$bYXb∩∩w5+≥∞AI∨.A!¬%(A∨_A!%Y∪∨+&4∀∪π∨0\Aεf1,f∩∩m≠+≥∞↓π∨→+5≤A!βI(A∨↓≥1(4∀∪%∨\\A$d1,d∩∩m≠+≥∞↓¬∨)⊂↓∨A)!∪&A-∃%)1L~∀∪π=_\AεHY,d~(∪∂≡AY_f∩∩$w ∨≤≥(A¬∨Q⊂A/∪Q⊂A%M(~∃-0dt∪π¬≠≤AεDYεd∩$w⊃∨.↓β¬∨+PA
%∨4Aπ∨→U≠≤A)<A%∨.|~∀∪π¬≠
A$HY$f~(∪∂≡AY_f∩∩$w≥∨(↓)⊃β(↓/β2A∃∪)⊃H~∀∪≠=-
@`1$b∩∩mβ≥λA¬%
A¬=)⊂A→∃∂&A→=≥∂$↓)⊃β≤↓∨%)⊃
∨≤}~(∪'+∧`Y$d4∀∪≠∨Y~@`X@~∀∪π¬∪∞@`0b``~(∪∂≡AY_f~∀l∪πβ≠≥
@`Y=%)⊃π=≤~∀v%∂≡A-0f∩∩∩m%∨.AAβ%(AQ∨≡A'!∨%(~(∪≠∨-∀@bYεH~∀∪'U∧@bYf~∀∪5∨-~@DXb~∀%πβ∪∞bXb`@~∀∪∂<A-_f4∀∪∪≠U_@bX@~∀∪π¬≠∂
@DY∨%)!π∨≤~(∪∂≡AY_f∩∩$wπ∨→U≠≤A!¬%(A)=≡A'⊃=%(~∀%π∨_\↓εbY,D∩∩w≠NG COLUMN PART OF PREVIOUS
ROW. R3,V3 ;MUNG ROW PART OF NEXT
ROW. R2,V2 ;MUNG BOTH OF THIS VERTEX
COL. C2,V2
VL3: CAME V3,V0 ;DONE YET
GO VLOOP
PGON 1,V0
CALL(FNDPSON,1)
POP1J ;YES, RETURN
SUBREND ORTHMUNG
INTERNAL ORTHCON
ORTHCON: 500
NSUBR SMOOTH,LEVEL
;BEGIN SMOOTH; -BGB- 6 DEC 1972.
ACCUMULATORS{V1,V2,PG,E0,E1,E2}
SKIPN FLGARC↔POP1J ;MAKE ARC ENABLED ?
MOVE 1,ARG1
TEST 1,LBIT
GO [ FATAL(SMOOTH CALLED WITH NON-LEVEL)]
SON PG,1↔SKIPN PG↔POP1J
MOVEM PG,PG0#
;POLYGON INITIALIZATION.
L1: MOVEM PG,PGSAVE#
SON V1,PG↔MOVEM V1,E0SAVE# ;UPPER MOST LEFT VERTEX.
ARC V2,PG ;LOWER MOST RIGHT VERTEX.
TESTZ V2,ARCBIT↔POP1J ;END OF LEVEL'S POLYGON RING.
JUMPE V2,[CALL(KLARCP,PG)
MOVE PG,PGSAVE
ARC V2,PG
JUMPE V2,[FATAL<CAN'T SMOOTH THIS, ARC POINTER IN POLYGON>]
GO L1]
;CREATE ARC NODES AT POLYGON'S EXTREME CORNERS.
SETQ(ARC2,{MAKE,[VBIT+ARCBIT+VREL]})
MOVE RC(V2)↔MOVEM RC(1)↔ARC. 1,V2↔ARC. V2,1
SETQ(ARC1,{MAKE,[VBIT+ARCBIT+VREL]})
MOVE RC(V1)↔MOVEM RC(1)↔ARC. 1,V1↔ARC. V1,1
MOVE 2,ARC2↔CCW. 1,2↔CW. 1,2↔CCW. 2,1↔CW. 2,1
PGON. PG,1↔PGON. PG,2↔ARC. 1,PG
;CALL FOR CREATION OF THE INTERMEDIATE ARC NODES.
SETZM AVCNT
CALL(MKARCS,ARC1,ARC2)
CALL(MKARCS,ARC2,ARC1)
;KILL TWO-SIDED ARC-POLYGONS AND ADVANCE TO NEXT POLYGON.
SKIPN AVCNT↔GO[
SETQ(PG,{KLPOLY,PGSAVE})
JUMPN PG,L1↔POP1J]
; CALL(FARCL,PGSAVE)
MOVE PG,PGSAVE↔CCW PG,PG↔GO L1
LIT
DECLARE{ARC1,ARC2}
SUBREND SMOOTH;9-JAN-73(BGB),21-APR-73(TVR)
;_________________________________________________________________
DECLARE{AVCNT} ;ARC-VERTEX COUNT.
NSUBR MKARCS,VERT1,VERT2 ;MAKE ARCS - FROM U1 CCW TO U2
; BGB - AUG 1972.
ACCUMULATORS{D,U1,U2,V1,V2,A,B,C,U,V}
MOVE V1,ARG2↔MOVE V2,ARG1
;CHECK FOR TRIVIAL CASE.
L0: ARC U1,V1↔ARC U2,V2
CCW 0,U1↔CAMN 0,U2↔GO L3
;COMPUTE NORMALIZED ARC EDGE COEFFICIENTS.
ROW A,V1↔FLO A, ; A ← Y1.
COL B,V2↔FLO B, ; B ← X2.
COL C,V1↔FLO C, ; C ← X1.
ROW D,V2↔FLO D, ; D ← Y2.
MOVE 1,B↔FMPR 1,A ; 1 ← X2*Y1.
FSBR A,D↔FSBR B,C ; A ← Y1-Y2. B ← X2-X1.
FMPR C,D↔FSBR C,1 ; C ← X1*Y2 - X2*Y1.
MOVE 0,A↔FMPR 0,0↔MOVE 1,B↔FMPR 1,1↔FADR 1,0
CALL SQRT,1↔FDVR A,1↔FDVR B,1↔FDVR C,1
MOVE 0,A↔FMPR 0,A↔HLLM 0,6(V1)
MOVE 0,B↔FMPR 0,B↔HLRM 0,6(V1)
;SET 'EM UP FOR AN ARC PASS.
ARC U1,V1↔ARC U2,V2
SETZM DMAX#↔SETZM DMIN#
SETZM VMAX#↔SETZM VMIN#
SETZM MAXCON#
;GO FROM U1 CCW TO U2 AND FIND THE U FURTHEST OFF THE ARC-EDGE.
L1: CCW U1,U1↔CAMN U1,U2↔GO L2
COL 0,U1↔FLO 0,↔ROW 1,U1↔FLO 1,
FMPR 0,A↔FMPR 1,B↔MOVE D,C↔FADR D,0↔FADR D,1
CAMGE D,DMIN↔GO [MOVEM U1,VMIN↔MOVEM D,DMIN↔GO .+1]
CAMLE D,DMAX↔GO [MOVEM U1,VMAX↔MOVEM D,DMAX↔GO .+1]
;KEEP TRACK OF MAXIMUM EDGE CONTRAST ALONG ARC.
; CNTRST 0,V1↔MOVM↔CAMLE MAXCON↔MOVEM MAXCON↔GO L1 ;FLUSHED FOR TVFONT
GO L1
;WHEN EXTREMA EXCEED ARCWID[MAXCON] THEN FORM ARC-POINTS.
L2: MOVE U,VMIN↔MOVM DMIN
CAMGE DMAX↔MOVE U,VMAX
CAMGE DMAX↔MOVE DMAX
; MOVE 1,MAXCON↔CAMGE ARCWID(1)↔GO L3 ;FLUSHED FORN TVFONT
CAMGE ARCWID↔GO L3
;OLDE ESPLIT.
SETQ(V,{MAKE,[VBIT+ARCBIT+VREL]})↔AOS AVCNT
ARC. U,V↔ARC. V,U
MOVE RC(U)↔MOVEM RC(V)↔PGON 0,U↔PGON. 0,V
CCW. V,V1↔CW. V1,V
CCW. V2,V↔CW. V,V2
MOVE V2,V↔GO L0
;ADVANCE CCW AN ARC-EDGE OR EXIT.
L3: CAMN V2,ARG1↔POP2J
MOVE V1,V2↔CCW V2,V2↔GO L0
SUBREND MKARCS;28-DEC-72(BGB)
NSUBR FARCL,PGON ;FIT ARCS LINEAR.
;BEGIN FARCL
X←←1
ACCUMULATORS{Y,SX,SY,XX,YY,XY,N,E,U1,U2,V1,V2}
;Clear the Locus of all the Arc Vertices.
; MOVE E,PGON↔DAD E,E↔MOVEM E,E0#
MOVE E,PGON↔ARC E,E↔MOVEM E,E0#
CCW V1,E ↔ SETZM RC(V1)
CCW E,V1 ↔ CAME E,E0↔JRST .-4
;Advance along Polygon.
CW V2,E
L1: MOVE V1,V2↔CCW V2,E
ARC U1,V1↔ARC U2,V2
; CW U1,U1↔CW U1,U1
; CW U1,U1↔CW U1,U1
; CW U1,U1↔CW U1,U1
; CCW U2,U2↔CCW U2,U2
; CCW U2,U2↔CCW U2,U2
; CCW U2,U2↔CCW U2,U2
;Arc Scan Initialization.
MOVE [XWD SX,SY]↔SETZ SX,↔BLT N↔JRST L2A
;Advance along VIC within the ARC.
;L2: CCW U1,U1↔CCW U1,U1
L2: CCW U1,U1
;Accumulate a Point.
L2A: COL X,U1↔FLO X,↔ROW Y,U1↔FLO Y,
FADR SX,X ↔ FADR SY,Y
MOVE X ↔ FMPR Y ↔ FADR XY,0
FMPR X,X ↔ FADR XX,X
FMPR Y,Y ↔ FADR YY,Y
CAME U1,U2↔AOJA N,L2↔AOS N
;----- FARCL COMPUTE SYMMETRIC LEAST SQUARES LINE COEFFICIENTS.
; Q ← N*XY - SY*SX.
; A ← Q + SY*SY - N*YY.
; B ← Q + SX*SX - N*XX.
; C ← SX*YY + SY*XX - XY*(SX+SY).
L3: MOVE 2,SX↔FMP 2,YY
MOVE 0,SY↔FMP 0,XX↔FAD 2,0
MOVE SX↔FAD SY↔FMP XY↔FSB 2,0↔MOVEM 2,CCCC#
FSC N,233↔FMP XX,N↔FMP XY,N↔FMP YY,N ;all the N terms.
MOVE SX↔FMP SY↔FSB XY,0 ;Q in XY.
FMP SY,SY↔FAD SY,XY↔FSB SY,YY↔MOVEM SY,AAAA#
FMP SX,SX↔FAD SX,XY↔FSB SX,XX↔MOVEM SX,BBBB#
FMP SY,SY↔FMP SX,SX↔FAD SX,SY
MOVSI(1.0)↔FDVR SX↔MOVEM QQQQ# ;PSEUDO NORMALIZATION.
;SOLVE FOR THE LOCII WHERE PERPENDICULARS DROPPED FROM
;THE ARC-EDGE HIT THE FITTED LINE.
; Q ← 1/(A*A + B*B).
; D ← (B*X1 - A*Y1).
; X ← (B*D - A*C)*Q.
; Y ←-(A*D + B*C)*Q.
L4: ARC U1,V1
COL X,U1↔FLO X,↔ROW Y,U1↔FLO Y,
FMP X,BBBB↔FMP Y,AAAA↔FSBR X,Y↔MOVN Y,X ;DDDD.
FMP X,BBBB↔FMP Y,AAAA
MOVE AAAA↔FMP CCCC↔FSBR X,↔FMPR X,QQQQ↔FIX X,226000
MOVE BBBB↔FMP CCCC↔FSBR Y,↔FMPR Y,QQQQ↔FIX Y,226000
HRLM Y,X↔ADDM X,RC(V1)
ARC U2,V2
COL X,U2↔FLO X,↔ROW Y,U2↔FLO Y,
FMP X,BBBB↔FMP Y,AAAA↔FSBR X,Y↔MOVN Y,X ;DDDD.
FMP X,BBBB↔FMP Y,AAAA
MOVE AAAA↔FMP CCCC↔FSBR X,↔FMPR X,QQQQ↔FIX X,226000
MOVE BBBB↔FMP CCCC↔FSBR Y,↔FMPR Y,QQQQ↔FIX Y,226000
HRLM Y,X↔ADDM X,RC(V2)
CCW E,V2↔CAME E,E0↔JRST L1
MOVE 12,AC12↔POP1J
SUBREND FARCL;6-JAN-73(BGB)
NSUBR KILVIC,LEVEL ;KILL VIDEO INTENSITY CONTOURS OF THE PREVIOUS LEVEL.
; BGB - 5 JANUARY 1973.
ACCUMULATORS{PG,E0,E1,E2,PG0}
SKIPN FLGARC↔POP1J ;MAKE ARC ENABLE.
SKIPN FLGU↔POP1J
MOVE 1,ARG1
TEST 1,LBIT
GO [ FATAL(KILVIC CALLED WITH NON-LEVEL)]
CW 1,1
SON PG,1
SKIPN PG0,PG↔POP1J
;RELEASE VIC NODES OF THE POLYGON.
L1: SON E0,PG
JUMPE E0,L3
SETZ↔SON. 0,PG
MOVE E1,E0
L2: CCW E2,E1
SETZ 0↔ARC 1,E1↔SKIPE 1↔ARC. 0,1
CALL(KILL,E1)
CAMN E2,E0↔GO L3
MOVE E1,E2↔GO L2
;ADVANCE TO NEXT POLYGON ON THIS LEVEL.
L3: CCW PG,PG
CAME PG,PG0↔GO L1
POP1J
SUBREND KILVIC;5-JAN-73(BGB)
;SUBRS KLARCL,KLARCP ;KILL ARCS OF LEVEL, OF POLYGON
NSUBR KLARCL,LVL ;KILL ARCS OF POLYGONS OF LEVEL
HRRZ 1,LVL
TEST 1,LBIT
GO [FATAL(KLARCL CALLED WITH NON-LEVEL)]
SON 1,1
MOVEM 1,PG0#
L1: CALL(KLARCP,1)
MOVE 1,1(P)
CCW 1,1
CAME 1,PG0
GO L1
POP1J
SUBREND KLARCL;27-FEB-73(TVR)
;_________________________________________________________________
NSUBR(KLARCP,POLYGON)
ACCUMULATORS{PG,V0,V1,V2,XMAX,YMAX}
HRRZ PG,POLYGON
TEST PG,PBIT
GO [FATAL(KLARCP CALLED WITH NON-POLYGON)]
SON 1,PG ;HAS HE BEEN ZAPPED?
JUMPE 1,POP1J. ;YES
ARC V0,PG ;GET ARC RING
JUMPE V0,FINDLR ;NONE THERE, MUST BE OLDE STYLE
TEST V0,ARCBIT ;IS IT AN ARC
GO FINDLR ;NO, CHECK LOWER RIGHT, JUST TO BE SURE
SETZ 0, ;FOR ZEROING POINTERS
MOVE V1,V0
L1: ARC 1,V1 ;GET CORRESPONDING VIC NODE
SKIPE 1 ;IS THERE ONE?
ARC. 0,1 ;ZERO HIS POINTER
CCW V2,V1 ;REMEMBER WHOSE NEXT
CALL(KILL,V1) ;FLUSH ARC
CAMN V2,V0 ;DONE YET?
GO FINDLR ;YES, NOW FIND LOWER RIGHT VERTEX
MOVE V1,V2 ;GET NEXT ARC
GO L1 ;AND REPEAT
FINDLR: SON V0,PG ;GET VIC RING
ROW YMAX,V0 ;INIT X AND Y DEFAULTS
COL XMAX,V0
MOVE V1,V0
ARC. 0,PG ;IN CASE WE DON'T FIND ANY
L2: CCW V1,V1 ;GET NEXT VERTEX
CAMN V1,V0 ;AT END?
POP1J ;YES, WE'RE DONE
ROW 1,V1
CAMGE 1,YMAX
GO L2
CAME 1,YMAX
GO [ COL 1,V1
CAMG 1,XMAX
GO L2
GO C1]
C1: ROW YMAX,V1 ;NEW X AND Y
COL XMAX,V1
ARC. V1,PG ;NEW LR VECTOR
GO L2
SUBREND KLARCP;27-FEB-73(TVR)
NSUBR(ARCVIC,LVL);MAKE ARC RING INTO VIC RING
ACCUMULATORS{P0,P1,V0,V1,MASK}
HRRZ 1,LVL
TEST 1,LBIT
GO [FATAL(ARCVIC CALLED WITH NON-LEVEL)]
SON P1,1
ARC V0,P1 ;MAKE SURE THERE AN ARC RING
JUMPE V0,POP1J.
TEST V0,ARCBIT
POP1J
CALL(KILVIC,LVL) ;FLUSH OLD VIC RING
HRRZ 1,LVL
SON P0,1
MOVE P1,P0
SETZ 0, ;FOR ZEROING POINTERS
MOVSI MASK,(ARCBIT) ;FOR FLUSHING ARC BITS IN TYPE FIELD
L1: ARC V0,P1 ;MOVE ARC RING TO VIC RING POSITION
SON. V0,P1
ARC. 0,P1
MOVE V1,V0
L2: ANDCAM MASK,2(V1) ;FLUSH ARCBIT AND ARC POINTER AROUND RING
HRRZS 4(V1)
CCW V1,V1 ;NEXT VECTOR
CAME V1,V0 ;END OF ARC RING?
GO L2 ;NO
CCW P1,P1 ;NEXT POLYGON
CAME P1,P0 ;END OF POLYGON RING
GO L1 ;NO
GO KLARCL ;NOW, FIND LOWER RIGHT FOR FUTURE SMOOTHING
SUBREND ARCVIC;27-FEB-73(TVR)